home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / perl5 / 5.8.7 / Math / BigRat.pm < prev    next >
Text File  |  2006-04-25  |  45KB  |  1,689 lines
  1.  
  2. #
  3. # "Tax the rat farms." - Lord Vetinari
  4. #
  5.  
  6. # The following hash values are used:
  7. #   sign : +,-,NaN,+inf,-inf
  8. #   _d   : denominator
  9. #   _n   : numeraotr (value = _n/_d)
  10. #   _a   : accuracy
  11. #   _p   : precision
  12. # You should not look at the innards of a BigRat - use the methods for this.
  13.  
  14. package Math::BigRat;
  15.  
  16. require 5.005_03;
  17. use strict;
  18.  
  19. use Math::BigFloat;
  20. use vars qw($VERSION @ISA $upgrade $downgrade
  21.             $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
  22.  
  23. @ISA = qw(Math::BigFloat);
  24.  
  25. $VERSION = '0.15';
  26.  
  27. use overload;            # inherit overload from Math::BigFloat
  28.  
  29. BEGIN
  30.   { 
  31.   *objectify = \&Math::BigInt::objectify;     # inherit this from BigInt
  32.   *AUTOLOAD = \&Math::BigFloat::AUTOLOAD;    # can't inherit AUTOLOAD
  33.   # we inherit these from BigFloat because currently it is not possible
  34.   # that MBF has a different $MBI variable than we, because MBF also uses
  35.   # Math::BigInt::config->('lib'); (there is always only one library loaded)
  36.   *_e_add = \&Math::BigFloat::_e_add;
  37.   *_e_sub = \&Math::BigFloat::_e_sub;
  38.   *as_int = \&as_number;
  39.   *is_pos = \&is_positive;
  40.   *is_neg = \&is_negative;
  41.   }
  42.  
  43. ##############################################################################
  44. # Global constants and flags. Access these only via the accessor methods!
  45.  
  46. $accuracy = $precision = undef;
  47. $round_mode = 'even';
  48. $div_scale = 40;
  49. $upgrade = undef;
  50. $downgrade = undef;
  51.  
  52. # These are internally, and not to be used from the outside at all!
  53.  
  54. $_trap_nan = 0;                         # are NaNs ok? set w/ config()
  55. $_trap_inf = 0;                         # are infs ok? set w/ config()
  56.  
  57. # the package we are using for our private parts, defaults to:
  58. # Math::BigInt->config()->{lib}
  59. my $MBI = 'Math::BigInt::Calc';
  60.  
  61. my $nan = 'NaN';
  62. my $class = 'Math::BigRat';
  63.  
  64. sub isa
  65.   {
  66.   return 0 if $_[1] =~ /^Math::Big(Int|Float)/;        # we aren't
  67.   UNIVERSAL::isa(@_);
  68.   }
  69.  
  70. ##############################################################################
  71.  
  72. sub _new_from_float
  73.   {
  74.   # turn a single float input into a rational number (like '0.1')
  75.   my ($self,$f) = @_;
  76.  
  77.   return $self->bnan() if $f->is_nan();
  78.   return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
  79.  
  80.   $self->{_n} = $MBI->_copy( $f->{_m} );    # mantissa
  81.   $self->{_d} = $MBI->_one();
  82.   $self->{sign} = $f->{sign} || '+';
  83.   if ($f->{_es} eq '-')
  84.     {
  85.     # something like Math::BigRat->new('0.1');
  86.     # 1 / 1 => 1/10
  87.     $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);    
  88.     }
  89.   else
  90.     {
  91.     # something like Math::BigRat->new('10');
  92.     # 1 / 1 => 10/1
  93.     $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless 
  94.       $MBI->_is_zero($f->{_e});    
  95.     }
  96.   $self;
  97.   }
  98.  
  99. sub new
  100.   {
  101.   # create a Math::BigRat
  102.   my $class = shift;
  103.  
  104.   my ($n,$d) = @_;
  105.  
  106.   my $self = { }; bless $self,$class;
  107.  
  108.   # input like (BigInt) or (BigFloat):
  109.   if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
  110.     {
  111.     if ($n->isa('Math::BigFloat'))
  112.       {
  113.       $self->_new_from_float($n);
  114.       }
  115.     if ($n->isa('Math::BigInt'))
  116.       {
  117.       # TODO: trap NaN, inf
  118.       $self->{_n} = $MBI->_copy($n->{value});        # "mantissa" = N
  119.       $self->{_d} = $MBI->_one();            # d => 1
  120.       $self->{sign} = $n->{sign};
  121.       }
  122.     if ($n->isa('Math::BigInt::Lite'))
  123.       {
  124.       # TODO: trap NaN, inf
  125.       $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
  126.       $self->{_n} = $MBI->_new(abs($$n));        # "mantissa" = N
  127.       $self->{_d} = $MBI->_one();            # d => 1
  128.       }
  129.     return $self->bnorm();                # normalize (120/1 => 12/10)
  130.     }
  131.  
  132.   # input like (BigInt,BigInt) or (BigLite,BigLite):
  133.   if (ref($d) && ref($n))
  134.     {
  135.     # do N first (for $self->{sign}):
  136.     if ($n->isa('Math::BigInt'))
  137.       {
  138.       # TODO: trap NaN, inf
  139.       $self->{_n} = $MBI->_copy($n->{value});        # "mantissa" = N
  140.       $self->{sign} = $n->{sign};
  141.       }
  142.     elsif ($n->isa('Math::BigInt::Lite'))
  143.       {
  144.       # TODO: trap NaN, inf
  145.       $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
  146.       $self->{_n} = $MBI->_new(abs($$n));        # "mantissa" = $n
  147.       }
  148.     else
  149.       {
  150.       require Carp;
  151.       Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
  152.       }
  153.     # now D:
  154.     if ($d->isa('Math::BigInt'))
  155.       {
  156.       # TODO: trap NaN, inf
  157.       $self->{_d} = $MBI->_copy($d->{value});        # "mantissa" = D
  158.       # +/+ or -/- => +, +/- or -/+ => -
  159.       $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
  160.       }
  161.     elsif ($d->isa('Math::BigInt::Lite'))
  162.       {
  163.       # TODO: trap NaN, inf
  164.       $self->{_d} = $MBI->_new(abs($$d));        # "mantissa" = D
  165.       my $ds = '+'; $ds = '-' if $$d < 0;
  166.       # +/+ or -/- => +, +/- or -/+ => -
  167.       $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
  168.       }
  169.     else
  170.       {
  171.       require Carp;
  172.       Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
  173.       }
  174.     return $self->bnorm();                # normalize (120/1 => 12/10)
  175.     }
  176.   return $n->copy() if ref $n;                # already a BigRat
  177.  
  178.   if (!defined $n)
  179.     {
  180.     $self->{_n} = $MBI->_zero();            # undef => 0
  181.     $self->{_d} = $MBI->_one();
  182.     $self->{sign} = '+';
  183.     return $self;
  184.     }
  185.  
  186.   # string input with / delimiter
  187.   if ($n =~ /\s*\/\s*/)
  188.     {
  189.     return $class->bnan() if $n =~ /\/.*\//;    # 1/2/3 isn't valid
  190.     return $class->bnan() if $n =~ /\/\s*$/;    # 1/ isn't valid
  191.     ($n,$d) = split (/\//,$n);
  192.     # try as BigFloats first
  193.     if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
  194.       {
  195.       local $Math::BigFloat::accuracy = undef;
  196.       local $Math::BigFloat::precision = undef;
  197.  
  198.       # one of them looks like a float 
  199.       my $nf = Math::BigFloat->new($n,undef,undef);
  200.       $self->{sign} = '+';
  201.       return $self->bnan() if $nf->is_nan();
  202.  
  203.       $self->{_n} = $MBI->_copy( $nf->{_m} );    # get mantissa
  204.  
  205.       # now correct $self->{_n} due to $n
  206.       my $f = Math::BigFloat->new($d,undef,undef);
  207.       return $self->bnan() if $f->is_nan();
  208.       $self->{_d} = $MBI->_copy( $f->{_m} );
  209.  
  210.       # calculate the difference between nE and dE
  211.       # XXX TODO: check that exponent() makes a copy to avoid copy()
  212.       my $diff_e = $nf->exponent()->copy()->bsub( $f->exponent);
  213.       if ($diff_e->is_negative())
  214.     {
  215.         # < 0: mul d with it
  216.         $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
  217.     }
  218.       elsif (!$diff_e->is_zero())
  219.         {
  220.         # > 0: mul n with it
  221.         $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
  222.         }
  223.       }
  224.     else
  225.       {
  226.       # both d and n look like (big)ints
  227.  
  228.       $self->{sign} = '+';                    # no sign => '+'
  229.       $self->{_n} = undef;
  230.       $self->{_d} = undef;
  231.       if ($n =~ /^([+-]?)0*(\d+)\z/)                # first part ok?
  232.     {
  233.     $self->{sign} = $1 || '+';                # no sign => '+'
  234.     $self->{_n} = $MBI->_new($2 || 0);
  235.         }
  236.  
  237.       if ($d =~ /^([+-]?)0*(\d+)\z/)                # second part ok?
  238.     {
  239.     $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-';    # negate if second part neg.
  240.     $self->{_d} = $MBI->_new($2 || 0);
  241.         }
  242.  
  243.       if (!defined $self->{_n} || !defined $self->{_d})
  244.     {
  245.         $d = Math::BigInt->new($d,undef,undef) unless ref $d;
  246.         $n = Math::BigInt->new($n,undef,undef) unless ref $n;
  247.  
  248.         if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
  249.       { 
  250.       # both parts are ok as integers (wierd things like ' 1e0'
  251.           $self->{_n} = $MBI->_copy($n->{value});
  252.           $self->{_d} = $MBI->_copy($d->{value});
  253.           $self->{sign} = $n->{sign};
  254.           $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-';    # -1/-2 => 1/2
  255.           return $self->bnorm();
  256.       }
  257.  
  258.         $self->{sign} = '+';                    # a default sign
  259.         return $self->bnan() if $n->is_nan() || $d->is_nan();
  260.  
  261.     # handle inf cases:
  262.         if ($n->is_inf() || $d->is_inf())
  263.       {
  264.       if ($n->is_inf())
  265.         {
  266.         return $self->bnan() if $d->is_inf();        # both are inf => NaN
  267.         my $s = '+';         # '+inf/+123' or '-inf/-123'
  268.         $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
  269.         # +-inf/123 => +-inf
  270.         return $self->binf($s);
  271.         }
  272.           # 123/inf => 0
  273.           return $self->bzero();
  274.       }
  275.     }
  276.       }
  277.  
  278.     return $self->bnorm();
  279.     }
  280.  
  281.   # simple string input
  282.   if (($n =~ /[\.eE]/))
  283.     {
  284.     # looks like a float, quacks like a float, so probably is a float
  285.     $self->{sign} = 'NaN';
  286.     local $Math::BigFloat::accuracy = undef;
  287.     local $Math::BigFloat::precision = undef;
  288.     $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
  289.     }
  290.   else
  291.     {
  292.     # for simple forms, use $MBI directly
  293.     if ($n =~ /^([+-]?)0*(\d+)\z/)
  294.       {
  295.       $self->{sign} = $1 || '+';
  296.       $self->{_n} = $MBI->_new($2 || 0);
  297.       $self->{_d} = $MBI->_one();
  298.       }
  299.     else
  300.       {
  301.       my $n = Math::BigInt->new($n,undef,undef);
  302.       $self->{_n} = $MBI->_copy($n->{value});
  303.       $self->{_d} = $MBI->_one();
  304.       $self->{sign} = $n->{sign};
  305.       return $self->bnan() if $self->{sign} eq 'NaN';
  306.       return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
  307.       }
  308.     }
  309.   $self->bnorm();
  310.   }
  311.  
  312. sub copy
  313.   {
  314.   # if two arguments, the first one is the class to "swallow" subclasses
  315.   my ($c,$x) = @_;
  316.  
  317.   if (scalar @_ == 1)
  318.     {
  319.     $x = $_[0];
  320.     $c = ref($x);
  321.     }
  322.   return unless ref($x); # only for objects
  323.  
  324.   my $self = bless {}, $c;
  325.  
  326.   $self->{sign} = $x->{sign};
  327.   $self->{_d} = $MBI->_copy($x->{_d});
  328.   $self->{_n} = $MBI->_copy($x->{_n});
  329.   $self->{_a} = $x->{_a} if defined $x->{_a};
  330.   $self->{_p} = $x->{_p} if defined $x->{_p};
  331.   $self;
  332.   }
  333.  
  334. ##############################################################################
  335.  
  336. sub config
  337.   {
  338.   # return (later set?) configuration data as hash ref
  339.   my $class = shift || 'Math::BigRat';
  340.  
  341.   my $cfg = $class->SUPER::config(@_);
  342.  
  343.   # now we need only to override the ones that are different from our parent
  344.   $cfg->{class} = $class;
  345.   $cfg->{with} = $MBI;
  346.   $cfg;
  347.   }
  348.  
  349. ##############################################################################
  350.  
  351. sub bstr
  352.   {
  353.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  354.  
  355.   if ($x->{sign} !~ /^[+-]$/)        # inf, NaN etc
  356.     {
  357.     my $s = $x->{sign}; $s =~ s/^\+//;     # +inf => inf
  358.     return $s;
  359.     }
  360.  
  361.   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';    # '+3/2' => '3/2'
  362.  
  363.   return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
  364.   $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
  365.   }
  366.  
  367. sub bsstr
  368.   {
  369.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  370.  
  371.   if ($x->{sign} !~ /^[+-]$/)        # inf, NaN etc
  372.     {
  373.     my $s = $x->{sign}; $s =~ s/^\+//;     # +inf => inf
  374.     return $s;
  375.     }
  376.   
  377.   my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';    # +3 vs 3
  378.   $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
  379.   }
  380.  
  381. sub bnorm
  382.   {
  383.   # reduce the number to the shortest form
  384.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  385.  
  386.   # Both parts must be objects of whatever we are using today.
  387.   # Second check because Calc.pm has ARRAY res as unblessed objects.
  388.   if (ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY')
  389.     {
  390.     require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).') in bnorm()');
  391.     }
  392.   if (ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY')
  393.     {
  394.     require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).') in bnorm()');
  395.     }
  396.  
  397.   # no normalize for NaN, inf etc.
  398.   return $x if $x->{sign} !~ /^[+-]$/;
  399.  
  400.   # normalize zeros to 0/1
  401.   if ($MBI->_is_zero($x->{_n}))
  402.     {
  403.     $x->{sign} = '+';                    # never leave a -0
  404.     $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
  405.     return $x;
  406.     }
  407.  
  408.   return $x if $MBI->_is_one($x->{_d});            # no need to reduce
  409.  
  410.   # reduce other numbers
  411.   my $gcd = $MBI->_copy($x->{_n});
  412.   $gcd = $MBI->_gcd($gcd,$x->{_d});
  413.   
  414.   if (!$MBI->_is_one($gcd))
  415.     {
  416.     $x->{_n} = $MBI->_div($x->{_n},$gcd);
  417.     $x->{_d} = $MBI->_div($x->{_d},$gcd);
  418.     }
  419.   $x;
  420.   }
  421.  
  422. ##############################################################################
  423. # sign manipulation
  424.  
  425. sub bneg
  426.   {
  427.   # (BRAT or num_str) return BRAT
  428.   # negate number or make a negated number from string
  429.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  430.  
  431.   return $x if $x->modify('bneg');
  432.  
  433.   # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
  434.   $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
  435.   $x;
  436.   }
  437.  
  438. ##############################################################################
  439. # special values
  440.  
  441. sub _bnan
  442.   {
  443.   # used by parent class bnan() to initialize number to NaN
  444.   my $self = shift;
  445.  
  446.   if ($_trap_nan)
  447.     {
  448.     require Carp;
  449.     my $class = ref($self);
  450.     # "$self" below will stringify the object, this blows up if $self is a
  451.     # partial object (happens under trap_nan), so fix it beforehand
  452.     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
  453.     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
  454.     Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
  455.     }
  456.   $self->{_n} = $MBI->_zero();
  457.   $self->{_d} = $MBI->_zero();
  458.   }
  459.  
  460. sub _binf
  461.   {
  462.   # used by parent class bone() to initialize number to +inf/-inf
  463.   my $self = shift;
  464.  
  465.   if ($_trap_inf)
  466.     {
  467.     require Carp;
  468.     my $class = ref($self);
  469.     # "$self" below will stringify the object, this blows up if $self is a
  470.     # partial object (happens under trap_nan), so fix it beforehand
  471.     $self->{_d} = $MBI->_zero() unless defined $self->{_d};
  472.     $self->{_n} = $MBI->_zero() unless defined $self->{_n};
  473.     Carp::croak ("Tried to set $self to inf in $class\::_binf()");
  474.     }
  475.   $self->{_n} = $MBI->_zero();
  476.   $self->{_d} = $MBI->_zero();
  477.   }
  478.  
  479. sub _bone
  480.   {
  481.   # used by parent class bone() to initialize number to +1/-1
  482.   my $self = shift;
  483.   $self->{_n} = $MBI->_one();
  484.   $self->{_d} = $MBI->_one();
  485.   }
  486.  
  487. sub _bzero
  488.   {
  489.   # used by parent class bzero() to initialize number to 0
  490.   my $self = shift;
  491.   $self->{_n} = $MBI->_zero();
  492.   $self->{_d} = $MBI->_one();
  493.   }
  494.  
  495. ##############################################################################
  496. # mul/add/div etc
  497.  
  498. sub badd
  499.   {
  500.   # add two rational numbers
  501.  
  502.   # set up parameters
  503.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  504.   # objectify is costly, so avoid it
  505.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  506.     {
  507.     ($self,$x,$y,@r) = objectify(2,@_);
  508.     }
  509.  
  510.   # +inf + +inf => +inf,  -inf + -inf => -inf
  511.   return $x->binf(substr($x->{sign},0,1))
  512.     if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
  513.  
  514.   # +inf + -inf or -inf + +inf => NaN
  515.   return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
  516.  
  517.   #  1   1    gcd(3,4) = 1    1*3 + 1*4    7
  518.   #  - + -                  = --------- = --                 
  519.   #  4   3                      4*3       12
  520.  
  521.   # we do not compute the gcd() here, but simple do:
  522.   #  5   7    5*3 + 7*4   43
  523.   #  - + -  = --------- = --                 
  524.   #  4   3       4*3      12
  525.  
  526.   # and bnorm() will then take care of the rest
  527.  
  528.   # 5 * 3
  529.   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
  530.  
  531.   # 7 * 4
  532.   my $m = $MBI->_mul( $MBI->_copy( $y->{_n} ), $x->{_d} );
  533.  
  534.   # 5 * 3 + 7 * 4
  535.   ($x->{_n}, $x->{sign}) = _e_add( $x->{_n}, $m, $x->{sign}, $y->{sign});
  536.  
  537.   # 4 * 3
  538.   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
  539.  
  540.   # normalize result, and possible round
  541.   $x->bnorm()->round(@r);
  542.   }
  543.  
  544. sub bsub
  545.   {
  546.   # subtract two rational numbers
  547.  
  548.   # set up parameters
  549.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  550.   # objectify is costly, so avoid it
  551.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  552.     {
  553.     ($self,$x,$y,@r) = objectify(2,@_);
  554.     }
  555.  
  556.   # flip sign of $x, call badd(), then flip sign of result
  557.   $x->{sign} =~ tr/+-/-+/
  558.     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});    # not -0
  559.   $x->badd($y,@r);                # does norm and round
  560.   $x->{sign} =~ tr/+-/-+/ 
  561.     unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});    # not -0
  562.   $x;
  563.   }
  564.  
  565. sub bmul
  566.   {
  567.   # multiply two rational numbers
  568.   
  569.   # set up parameters
  570.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  571.   # objectify is costly, so avoid it
  572.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  573.     {
  574.     ($self,$x,$y,@r) = objectify(2,@_);
  575.     }
  576.  
  577.   return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
  578.  
  579.   # inf handling
  580.   if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
  581.     {
  582.     return $x->bnan() if $x->is_zero() || $y->is_zero();
  583.     # result will always be +-inf:
  584.     # +inf * +/+inf => +inf, -inf * -/-inf => +inf
  585.     # +inf * -/-inf => -inf, -inf * +/+inf => -inf
  586.     return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
  587.     return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
  588.     return $x->binf('-');
  589.     }
  590.  
  591.   # x== 0 # also: or y == 1 or y == -1
  592.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  593.  
  594.   # XXX TODO:
  595.   # According to Knuth, this can be optimized by doing gcd twice (for d and n)
  596.   # and reducing in one step. This would save us the bnorm() at the end.
  597.  
  598.   #  1   2    1 * 2    2    1
  599.   #  - * - =  -----  = -  = -
  600.   #  4   3    4 * 3    12   6
  601.   
  602.   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_n});
  603.   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_d});
  604.  
  605.   # compute new sign
  606.   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
  607.  
  608.   $x->bnorm()->round(@r);
  609.   }
  610.  
  611. sub bdiv
  612.   {
  613.   # (dividend: BRAT or num_str, divisor: BRAT or num_str) return
  614.   # (BRAT,BRAT) (quo,rem) or BRAT (only rem)
  615.  
  616.   # set up parameters
  617.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  618.   # objectify is costly, so avoid it
  619.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  620.     {
  621.     ($self,$x,$y,@r) = objectify(2,@_);
  622.     }
  623.  
  624.   return $self->_div_inf($x,$y)
  625.    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
  626.  
  627.   # x== 0 # also: or y == 1 or y == -1
  628.   return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
  629.  
  630.   # XXX TODO: list context, upgrade
  631.   # According to Knuth, this can be optimized by doing gcd twice (for d and n)
  632.   # and reducing in one step. This would save us the bnorm() at the end.
  633.  
  634.   # 1     1    1   3
  635.   # -  /  - == - * -
  636.   # 4     3    4   1
  637.   
  638.   $x->{_n} = $MBI->_mul( $x->{_n}, $y->{_d});
  639.   $x->{_d} = $MBI->_mul( $x->{_d}, $y->{_n});
  640.  
  641.   # compute new sign 
  642.   $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
  643.  
  644.   $x->bnorm()->round(@r);
  645.   $x;
  646.   }
  647.  
  648. sub bmod
  649.   {
  650.   # compute "remainder" (in Perl way) of $x / $y
  651.  
  652.   # set up parameters
  653.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  654.   # objectify is costly, so avoid it
  655.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  656.     {
  657.     ($self,$x,$y,@r) = objectify(2,@_);
  658.     }
  659.  
  660.   return $self->_div_inf($x,$y)
  661.    if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
  662.  
  663.   return $x if $x->is_zero();           # 0 / 7 = 0, mod 0
  664.  
  665.   # compute $x - $y * floor($x/$y), keeping the sign of $x
  666.  
  667.   # copy x to u, make it positive and then do a normal division ($u/$y)
  668.   my $u = bless { sign => '+' }, $self;
  669.   $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
  670.   $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
  671.   
  672.   # compute floor(u)
  673.   if (! $MBI->_is_one($u->{_d}))
  674.     {
  675.     $u->{_n} = $MBI->_div($u->{_n},$u->{_d});    # 22/7 => 3/1 w/ truncate
  676.     # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
  677.     }
  678.   
  679.   # now compute $y * $u
  680.   $u->{_d} = $MBI->_copy($y->{_d});        # 1 * $y->{_d}, see floor above
  681.   $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
  682.  
  683.   my $xsign = $x->{sign}; $x->{sign} = '+';    # remember sign and make x positive
  684.   # compute $x - $u
  685.   $x->bsub($u);
  686.   $x->{sign} = $xsign;                # put sign back
  687.  
  688.   $x->bnorm()->round(@r);
  689.   }
  690.  
  691. ##############################################################################
  692. # bdec/binc
  693.  
  694. sub bdec
  695.   {
  696.   # decrement value (subtract 1)
  697.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  698.  
  699.   return $x if $x->{sign} !~ /^[+-]$/;    # NaN, inf, -inf
  700.  
  701.   if ($x->{sign} eq '-')
  702.     {
  703.     $x->{_n} = $MBI->_add( $x->{_n}, $x->{_d});        # -5/2 => -7/2
  704.     }
  705.   else
  706.     {
  707.     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)        # n < d?
  708.       {
  709.       # 1/3 -- => -2/3
  710.       $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
  711.       $x->{sign} = '-';
  712.       }
  713.     else
  714.       {
  715.       $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d});     # 5/2 => 3/2
  716.       }
  717.     }
  718.   $x->bnorm()->round(@r);
  719.   }
  720.  
  721. sub binc
  722.   {
  723.   # increment value (add 1)
  724.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  725.   
  726.   return $x if $x->{sign} !~ /^[+-]$/;    # NaN, inf, -inf
  727.  
  728.   if ($x->{sign} eq '-')
  729.     {
  730.     if ($MBI->_acmp($x->{_n},$x->{_d}) < 0)
  731.       {
  732.       # -1/3 ++ => 2/3 (overflow at 0)
  733.       $x->{_n} = $MBI->_sub( $MBI->_copy($x->{_d}), $x->{_n});
  734.       $x->{sign} = '+';
  735.       }
  736.     else
  737.       {
  738.       $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d});     # -5/2 => -3/2
  739.       }
  740.     }
  741.   else
  742.     {
  743.     $x->{_n} = $MBI->_add($x->{_n},$x->{_d});        # 5/2 => 7/2
  744.     }
  745.   $x->bnorm()->round(@r);
  746.   }
  747.  
  748. ##############################################################################
  749. # is_foo methods (the rest is inherited)
  750.  
  751. sub is_int
  752.   {
  753.   # return true if arg (BRAT or num_str) is an integer
  754.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  755.  
  756.   return 1 if ($x->{sign} =~ /^[+-]$/) &&    # NaN and +-inf aren't
  757.     $MBI->_is_one($x->{_d});            # x/y && y != 1 => no integer
  758.   0;
  759.   }
  760.  
  761. sub is_zero
  762.   {
  763.   # return true if arg (BRAT or num_str) is zero
  764.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  765.  
  766.   return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n});
  767.   0;
  768.   }
  769.  
  770. sub is_one
  771.   {
  772.   # return true if arg (BRAT or num_str) is +1 or -1 if signis given
  773.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  774.  
  775.   my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
  776.   return 1
  777.    if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}));
  778.   0;
  779.   }
  780.  
  781. sub is_odd
  782.   {
  783.   # return true if arg (BFLOAT or num_str) is odd or false if even
  784.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  785.  
  786.   return 1 if ($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
  787.     ($MBI->_is_one($x->{_d}) && $MBI->_is_odd($x->{_n})); # x/2 is not, but 3/1
  788.   0;
  789.   }
  790.  
  791. sub is_even
  792.   {
  793.   # return true if arg (BINT or num_str) is even or false if odd
  794.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  795.  
  796.   return 0 if $x->{sign} !~ /^[+-]$/;            # NaN & +-inf aren't
  797.   return 1 if ($MBI->_is_one($x->{_d})            # x/3 is never
  798.      && $MBI->_is_even($x->{_n}));            # but 4/1 is
  799.   0;
  800.   }
  801.  
  802. ##############################################################################
  803. # parts() and friends
  804.  
  805. sub numerator
  806.   {
  807.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  808.  
  809.   # NaN, inf, -inf
  810.   return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
  811.  
  812.   my $n = Math::BigInt->new($MBI->_str($x->{_n})); $n->{sign} = $x->{sign};
  813.   $n;
  814.   }
  815.  
  816. sub denominator
  817.   {
  818.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  819.  
  820.   # NaN
  821.   return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
  822.   # inf, -inf
  823.   return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
  824.   
  825.   Math::BigInt->new($MBI->_str($x->{_d}));
  826.   }
  827.  
  828. sub parts
  829.   {
  830.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  831.  
  832.   my $c = 'Math::BigInt';
  833.  
  834.   return ($c->bnan(),$c->bnan()) if $x->{sign} eq 'NaN';
  835.   return ($c->binf(),$c->binf()) if $x->{sign} eq '+inf';
  836.   return ($c->binf('-'),$c->binf()) if $x->{sign} eq '-inf';
  837.  
  838.   my $n = $c->new( $MBI->_str($x->{_n}));
  839.   $n->{sign} = $x->{sign};
  840.   my $d = $c->new( $MBI->_str($x->{_d}));
  841.   ($n,$d);
  842.   }
  843.  
  844. sub length
  845.   {
  846.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  847.  
  848.   return $nan unless $x->is_int();
  849.   $MBI->_len($x->{_n});                # length(-123/1) => length(123)
  850.   }
  851.  
  852. sub digit
  853.   {
  854.   my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_);
  855.  
  856.   return $nan unless $x->is_int();
  857.   $MBI->_digit($x->{_n},$n || 0);        # digit(-123/1,2) => digit(123,2)
  858.   }
  859.  
  860. ##############################################################################
  861. # special calc routines
  862.  
  863. sub bceil
  864.   {
  865.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  866.  
  867.   return $x if $x->{sign} !~ /^[+-]$/ ||    # not for NaN, inf
  868.             $MBI->_is_one($x->{_d});        # 22/1 => 22, 0/1 => 0
  869.  
  870.   $x->{_n} = $MBI->_div($x->{_n},$x->{_d});    # 22/7 => 3/1 w/ truncate
  871.   $x->{_d} = $MBI->_one();            # d => 1
  872.   $x->{_n} = $MBI->_inc($x->{_n})
  873.     if $x->{sign} eq '+';            # +22/7 => 4/1
  874.   $x->{sign} = '+' if $MBI->_is_zero($x->{_n});    # -0 => 0
  875.   $x;
  876.   }
  877.  
  878. sub bfloor
  879.   {
  880.   my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
  881.  
  882.   return $x if $x->{sign} !~ /^[+-]$/ ||    # not for NaN, inf
  883.             $MBI->_is_one($x->{_d});        # 22/1 => 22, 0/1 => 0
  884.  
  885.   $x->{_n} = $MBI->_div($x->{_n},$x->{_d});    # 22/7 => 3/1 w/ truncate
  886.   $x->{_d} = $MBI->_one();            # d => 1
  887.   $x->{_n} = $MBI->_inc($x->{_n})
  888.     if $x->{sign} eq '-';            # -22/7 => -4/1
  889.   $x;
  890.   }
  891.  
  892. sub bfac
  893.   {
  894.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  895.  
  896.   # if $x is not an integer
  897.   if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d})))
  898.     {
  899.     return $x->bnan();
  900.     }
  901.  
  902.   $x->{_n} = $MBI->_fac($x->{_n});
  903.   # since _d is 1, we don't need to reduce/norm the result
  904.   $x->round(@r);
  905.   }
  906.  
  907. sub bpow
  908.   {
  909.   # power ($x ** $y)
  910.  
  911.   # set up parameters
  912.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  913.   # objectify is costly, so avoid it
  914.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  915.     {
  916.     ($self,$x,$y,@r) = objectify(2,@_);
  917.     }
  918.  
  919.   return $x if $x->{sign} =~ /^[+-]inf$/;       # -inf/+inf ** x
  920.   return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
  921.   return $x->bone(@r) if $y->is_zero();
  922.   return $x->round(@r) if $x->is_one() || $y->is_one();
  923.  
  924.   if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d}))
  925.     {
  926.     # if $x == -1 and odd/even y => +1/-1
  927.     return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
  928.     # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
  929.     }
  930.   # 1 ** -y => 1 / (1 ** |y|)
  931.   # so do test for negative $y after above's clause
  932.  
  933.   return $x->round(@r) if $x->is_zero();  # 0**y => 0 (if not y <= 0)
  934.  
  935.   # shortcut y/1 (and/or x/1)
  936.   if ($MBI->_is_one($y->{_d}))
  937.     {
  938.     # shortcut for x/1 and y/1
  939.     if ($MBI->_is_one($x->{_d}))
  940.       {
  941.       $x->{_n} = $MBI->_pow($x->{_n},$y->{_n});        # x/1 ** y/1 => (x ** y)/1
  942.       if ($y->{sign} eq '-')
  943.         {
  944.         # 0.2 ** -3 => 1/(0.2 ** 3)
  945.         ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});    # swap
  946.         }
  947.       # correct sign; + ** + => +
  948.       if ($x->{sign} eq '-')
  949.         {
  950.         # - * - => +, - * - * - => -
  951.         $x->{sign} = '+' if $MBI->_is_even($y->{_n});    
  952.         }
  953.       return $x->round(@r);
  954.       }
  955.     # x/z ** y/1
  956.     $x->{_n} = $MBI->_pow($x->{_n},$y->{_n});        # 5/2 ** y/1 => 5 ** y / 2 ** y
  957.     $x->{_d} = $MBI->_pow($x->{_d},$y->{_n});
  958.     if ($y->{sign} eq '-')
  959.       {
  960.       # 0.2 ** -3 => 1/(0.2 ** 3)
  961.       ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n});    # swap
  962.       }
  963.     # correct sign; + ** + => +
  964.     if ($x->{sign} eq '-')
  965.       {
  966.       # - * - => +, - * - * - => -
  967.       $x->{sign} = '+' if $MBI->_is_even($y->{_n});    
  968.       }
  969.     return $x->round(@r);
  970.     }
  971.  
  972.   # regular calculation (this is wrong for d/e ** f/g)
  973.   my $pow2 = $self->bone();
  974.   my $y1 = $MBI->_div ( $MBI->_copy($y->{_n}), $y->{_d});
  975.   my $two = $MBI->_two();
  976.  
  977.   while (!$MBI->_is_one($y1))
  978.     {
  979.     $pow2->bmul($x) if $MBI->_is_odd($y1);
  980.     $MBI->_div($y1, $two);
  981.     $x->bmul($x);
  982.     }
  983.   $x->bmul($pow2) unless $pow2->is_one();
  984.   # n ** -x => 1/n ** x
  985.   ($x->{_d},$x->{_n}) = ($x->{_n},$x->{_d}) if $y->{sign} eq '-'; 
  986.   $x->bnorm()->round(@r);
  987.   }
  988.  
  989. sub blog
  990.   {
  991.   # set up parameters
  992.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  993.  
  994.   # objectify is costly, so avoid it
  995.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  996.     {
  997.     ($self,$x,$y,@r) = objectify(2,$class,@_);
  998.     }
  999.  
  1000.   # blog(1,Y) => 0
  1001.   return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
  1002.  
  1003.   # $x <= 0 => NaN
  1004.   return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
  1005.  
  1006.   if ($x->is_int() && $y->is_int())
  1007.     {
  1008.     return $self->new($x->as_number()->blog($y->as_number(),@r));
  1009.     }
  1010.  
  1011.   # do it with floats
  1012.   $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
  1013.   }
  1014.  
  1015. sub _float_from_part
  1016.   {
  1017.   my $x = shift;
  1018.  
  1019.   my $f = Math::BigFloat->bzero();
  1020.   $f->{_m} = $MBI->_copy($x);
  1021.   $f->{_e} = $MBI->_zero();
  1022.  
  1023.   $f;
  1024.   }
  1025.  
  1026. sub _as_float
  1027.   {
  1028.   my $x = shift;
  1029.  
  1030.   local $Math::BigFloat::upgrade = undef;
  1031.   local $Math::BigFloat::accuracy = undef;
  1032.   local $Math::BigFloat::precision = undef;
  1033.   # 22/7 => 3.142857143..
  1034.  
  1035.   my $a = $x->accuracy() || 0;
  1036.   if ($a != 0 || !$MBI->_is_one($x->{_d}))
  1037.     {
  1038.     # n/d
  1039.     return Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv( $MBI->_str($x->{_d}), $x->accuracy());
  1040.     }
  1041.   # just n
  1042.   Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}));
  1043.   }
  1044.  
  1045. sub broot
  1046.   {
  1047.   # set up parameters
  1048.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  1049.   # objectify is costly, so avoid it
  1050.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1051.     {
  1052.     ($self,$x,$y,@r) = objectify(2,@_);
  1053.     }
  1054.  
  1055.   if ($x->is_int() && $y->is_int())
  1056.     {
  1057.     return $self->new($x->as_number()->broot($y->as_number(),@r));
  1058.     }
  1059.  
  1060.   # do it with floats
  1061.   $x->_new_from_float( $x->_as_float()->broot($y,@r) );
  1062.   }
  1063.  
  1064. sub bmodpow
  1065.   {
  1066.   # set up parameters
  1067.   my ($self,$x,$y,$m,@r) = (ref($_[0]),@_);
  1068.   # objectify is costly, so avoid it
  1069.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1070.     {
  1071.     ($self,$x,$y,$m,@r) = objectify(3,@_);
  1072.     }
  1073.  
  1074.   # $x or $y or $m are NaN or +-inf => NaN
  1075.   return $x->bnan()
  1076.    if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ ||
  1077.    $m->{sign} !~ /^[+-]$/;
  1078.  
  1079.   if ($x->is_int() && $y->is_int() && $m->is_int())
  1080.     {
  1081.     return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r));
  1082.     }
  1083.  
  1084.   warn ("bmodpow() not fully implemented");
  1085.   $x->bnan();
  1086.   }
  1087.  
  1088. sub bmodinv
  1089.   {
  1090.   # set up parameters
  1091.   my ($self,$x,$y,@r) = (ref($_[0]),@_);
  1092.   # objectify is costly, so avoid it
  1093.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1094.     {
  1095.     ($self,$x,$y,@r) = objectify(2,@_);
  1096.     }
  1097.  
  1098.   # $x or $y are NaN or +-inf => NaN
  1099.   return $x->bnan() 
  1100.    if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
  1101.  
  1102.   if ($x->is_int() && $y->is_int())
  1103.     {
  1104.     return $self->new($x->as_number()->bmodinv($y->as_number(),@r));
  1105.     }
  1106.  
  1107.   warn ("bmodinv() not fully implemented");
  1108.   $x->bnan();
  1109.   }
  1110.  
  1111. sub bsqrt
  1112.   {
  1113.   my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
  1114.  
  1115.   return $x->bnan() if $x->{sign} !~ /^[+]/;    # NaN, -inf or < 0
  1116.   return $x if $x->{sign} eq '+inf';            # sqrt(inf) == inf
  1117.   return $x->round(@r) if $x->is_zero() || $x->is_one();
  1118.  
  1119.   local $Math::BigFloat::upgrade = undef;
  1120.   local $Math::BigFloat::downgrade = undef;
  1121.   local $Math::BigFloat::precision = undef;
  1122.   local $Math::BigFloat::accuracy = undef;
  1123.   local $Math::BigInt::upgrade = undef;
  1124.   local $Math::BigInt::precision = undef;
  1125.   local $Math::BigInt::accuracy = undef;
  1126.  
  1127.   $x->{_n} = _float_from_part( $x->{_n} )->bsqrt();
  1128.   $x->{_d} = _float_from_part( $x->{_d} )->bsqrt();
  1129.  
  1130.   # XXX TODO: we probably can optimze this:
  1131.  
  1132.   # if sqrt(D) was not integer
  1133.   if ($x->{_d}->{_es} ne '+')
  1134.     {
  1135.     $x->{_n}->blsft($x->{_d}->exponent()->babs(),10);    # 7.1/4.51 => 7.1/45.1
  1136.     $x->{_d} = $MBI->_copy( $x->{_d}->{_m} );        # 7.1/45.1 => 71/45.1
  1137.     }
  1138.   # if sqrt(N) was not integer
  1139.   if ($x->{_n}->{_es} ne '+')
  1140.     {
  1141.     $x->{_d}->blsft($x->{_n}->exponent()->babs(),10);    # 71/45.1 => 710/45.1
  1142.     $x->{_n} = $MBI->_copy( $x->{_n}->{_m} );        # 710/45.1 => 710/451
  1143.     }
  1144.  
  1145.   # convert parts to $MBI again 
  1146.   $x->{_n} = $MBI->_lsft( $MBI->_copy( $x->{_n}->{_m} ), $x->{_n}->{_e}, 10)
  1147.     if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY';
  1148.   $x->{_d} = $MBI->_lsft( $MBI->_copy( $x->{_d}->{_m} ), $x->{_d}->{_e}, 10)
  1149.     if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY';
  1150.  
  1151.   $x->bnorm()->round(@r);
  1152.   }
  1153.  
  1154. sub blsft
  1155.   {
  1156.   my ($self,$x,$y,$b,@r) = objectify(3,@_);
  1157.  
  1158.   $b = 2 unless defined $b;
  1159.   $b = $self->new($b) unless ref ($b);
  1160.   $x->bmul( $b->copy()->bpow($y), @r);
  1161.   $x;
  1162.   }
  1163.  
  1164. sub brsft
  1165.   {
  1166.   my ($self,$x,$y,$b,@r) = objectify(3,@_);
  1167.  
  1168.   $b = 2 unless defined $b;
  1169.   $b = $self->new($b) unless ref ($b);
  1170.   $x->bdiv( $b->copy()->bpow($y), @r);
  1171.   $x;
  1172.   }
  1173.  
  1174. ##############################################################################
  1175. # round
  1176.  
  1177. sub round
  1178.   {
  1179.   $_[0];
  1180.   }
  1181.  
  1182. sub bround
  1183.   {
  1184.   $_[0];
  1185.   }
  1186.  
  1187. sub bfround
  1188.   {
  1189.   $_[0];
  1190.   }
  1191.  
  1192. ##############################################################################
  1193. # comparing
  1194.  
  1195. sub bcmp
  1196.   {
  1197.   # compare two signed numbers 
  1198.   
  1199.   # set up parameters
  1200.   my ($self,$x,$y) = (ref($_[0]),@_);
  1201.   # objectify is costly, so avoid it
  1202.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1203.     {
  1204.     ($self,$x,$y) = objectify(2,@_);
  1205.     }
  1206.  
  1207.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  1208.     {
  1209.     # handle +-inf and NaN
  1210.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  1211.     return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
  1212.     return +1 if $x->{sign} eq '+inf';
  1213.     return -1 if $x->{sign} eq '-inf';
  1214.     return -1 if $y->{sign} eq '+inf';
  1215.     return +1;
  1216.     }
  1217.   # check sign for speed first
  1218.   return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';   # does also 0 <=> -y
  1219.   return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # does also -x <=> 0
  1220.  
  1221.   # shortcut
  1222.   my $xz = $MBI->_is_zero($x->{_n});
  1223.   my $yz = $MBI->_is_zero($y->{_n});
  1224.   return 0 if $xz && $yz;                               # 0 <=> 0
  1225.   return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
  1226.   return 1 if $yz && $x->{sign} eq '+';                 # +x <=> 0
  1227.  
  1228.   my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
  1229.   my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
  1230.  
  1231.   my $cmp = $MBI->_acmp($t,$u);                # signs are equal
  1232.   $cmp = -$cmp if $x->{sign} eq '-';            # both are '-' => reverse
  1233.   $cmp;
  1234.   }
  1235.  
  1236. sub bacmp
  1237.   {
  1238.   # compare two numbers (as unsigned)
  1239.  
  1240.   # set up parameters
  1241.   my ($self,$x,$y) = (ref($_[0]),@_);
  1242.   # objectify is costly, so avoid it
  1243.   if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
  1244.     {
  1245.     ($self,$x,$y) = objectify(2,$class,@_);
  1246.     }
  1247.  
  1248.   if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
  1249.     {
  1250.     # handle +-inf and NaN
  1251.     return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
  1252.     return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
  1253.     return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
  1254.     return -1;
  1255.     }
  1256.  
  1257.   my $t = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d});
  1258.   my $u = $MBI->_mul( $MBI->_copy($y->{_n}), $x->{_d});
  1259.   $MBI->_acmp($t,$u);                    # ignore signs
  1260.   }
  1261.  
  1262. ##############################################################################
  1263. # output conversation
  1264.  
  1265. sub numify
  1266.   {
  1267.   # convert 17/8 => float (aka 2.125)
  1268.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1269.  
  1270.   return $x->bstr() if $x->{sign} !~ /^[+-]$/;    # inf, NaN, etc
  1271.  
  1272.   # N/1 => N
  1273.   my $neg = ''; $neg = '-' if $x->{sign} eq '-';
  1274.   return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
  1275.  
  1276.   $x->_as_float()->numify() + 0.0;
  1277.   }
  1278.  
  1279. sub as_number
  1280.   {
  1281.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1282.  
  1283.   return Math::BigInt->new($x) if $x->{sign} !~ /^[+-]$/;    # NaN, inf etc
  1284.  
  1285.   my $u = Math::BigInt->bzero();
  1286.   $u->{sign} = $x->{sign};
  1287.   $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d});    # 22/7 => 3
  1288.   $u;
  1289.   }
  1290.  
  1291. sub as_bin
  1292.   {
  1293.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1294.  
  1295.   return $x unless $x->is_int();
  1296.  
  1297.   my $s = $x->{sign}; $s = '' if $s eq '+';
  1298.   $s . $MBI->_as_bin($x->{_n});
  1299.   }
  1300.  
  1301. sub as_hex
  1302.   {
  1303.   my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
  1304.  
  1305.   return $x unless $x->is_int();
  1306.  
  1307.   my $s = $x->{sign}; $s = '' if $s eq '+';
  1308.   $s . $MBI->_as_hex($x->{_n});
  1309.   }
  1310.  
  1311. ##############################################################################
  1312. # import
  1313.  
  1314. sub import
  1315.   {
  1316.   my $self = shift;
  1317.   my $l = scalar @_;
  1318.   my $lib = ''; my @a;
  1319.  
  1320.   for ( my $i = 0; $i < $l ; $i++)
  1321.     {
  1322.     if ( $_[$i] eq ':constant' )
  1323.       {
  1324.       # this rest causes overlord er load to step in
  1325.       overload::constant float => sub { $self->new(shift); };
  1326.       }
  1327. #    elsif ($_[$i] eq 'upgrade')
  1328. #      {
  1329. #     # this causes upgrading
  1330. #      $upgrade = $_[$i+1];        # or undef to disable
  1331. #      $i++;
  1332. #      }
  1333.     elsif ($_[$i] eq 'downgrade')
  1334.       {
  1335.       # this causes downgrading
  1336.       $downgrade = $_[$i+1];        # or undef to disable
  1337.       $i++;
  1338.       }
  1339.     elsif ($_[$i] eq 'lib')
  1340.       {
  1341.       $lib = $_[$i+1] || '';        # default Calc
  1342.       $i++;
  1343.       }
  1344.     elsif ($_[$i] eq 'with')
  1345.       {
  1346.       # this argument is no longer used
  1347.       #$MBI = $_[$i+1] || 'Math::BigInt::Calc';    # default Math::BigInt::Calc
  1348.       $i++;
  1349.       }
  1350.     else
  1351.       {
  1352.       push @a, $_[$i];
  1353.       }
  1354.     }
  1355.   require Math::BigInt;
  1356.  
  1357.   # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
  1358.   if ($lib ne '')
  1359.     {
  1360.     my @c = split /\s*,\s*/, $lib;
  1361.     foreach (@c)
  1362.       {
  1363.       $_ =~ tr/a-zA-Z0-9://cd;                    # limit to sane characters
  1364.       }
  1365.     $lib = join(",", @c);
  1366.     }
  1367.   my @import = ('objectify');
  1368.   push @import, lib => $lib if $lib ne '';
  1369.  
  1370.   # MBI already loaded, so feed it our lib arguments
  1371.   Math::BigInt->import( @import );
  1372.  
  1373.   $MBI = Math::BigFloat->config()->{lib};
  1374.  
  1375.   # register us with MBI to get notified of future lib changes
  1376.   Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
  1377.   
  1378.   # any non :constant stuff is handled by our parent, Exporter (loaded
  1379.   # by Math::BigFloat, even if @_ is empty, to give it a chance
  1380.   $self->SUPER::import(@a);             # for subclasses
  1381.   $self->export_to_level(1,$self,@a);   # need this, too
  1382.   }
  1383.  
  1384. 1;
  1385.  
  1386. __END__
  1387.  
  1388. =head1 NAME
  1389.  
  1390. Math::BigRat - Arbitrary big rational numbers
  1391.  
  1392. =head1 SYNOPSIS
  1393.  
  1394.     use Math::BigRat;
  1395.  
  1396.     my $x = Math::BigRat->new('3/7'); $x += '5/9';
  1397.  
  1398.     print $x->bstr(),"\n";
  1399.       print $x ** 2,"\n";
  1400.  
  1401.     my $y = Math::BigRat->new('inf');
  1402.     print "$y ", ($y->is_inf ? 'is' : 'is not') , " infinity\n";
  1403.  
  1404.     my $z = Math::BigRat->new(144); $z->bsqrt();
  1405.  
  1406. =head1 DESCRIPTION
  1407.  
  1408. Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
  1409. for arbitrary big rational numbers.
  1410.  
  1411. =head2 MATH LIBRARY
  1412.  
  1413. Math with the numbers is done (by default) by a module called
  1414. Math::BigInt::Calc. This is equivalent to saying:
  1415.  
  1416.     use Math::BigRat lib => 'Calc';
  1417.  
  1418. You can change this by using:
  1419.  
  1420.     use Math::BigRat lib => 'BitVect';
  1421.  
  1422. The following would first try to find Math::BigInt::Foo, then
  1423. Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
  1424.  
  1425.     use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
  1426.  
  1427. Calc.pm uses as internal format an array of elements of some decimal base
  1428. (usually 1e7, but this might be different for some systems) with the least
  1429. significant digit first, while BitVect.pm uses a bit vector of base 2, most
  1430. significant bit first. Other modules might use even different means of
  1431. representing the numbers. See the respective module documentation for further
  1432. details.
  1433.  
  1434. Currently the following replacement libraries exist, search for them at CPAN:
  1435.  
  1436.     Math::BigInt::BitVect
  1437.     Math::BigInt::GMP
  1438.     Math::BigInt::Pari
  1439.     Math::BigInt::FastCalc
  1440.  
  1441. =head1 METHODS
  1442.  
  1443. Any methods not listed here are dervied from Math::BigFloat (or
  1444. Math::BigInt), so make sure you check these two modules for further
  1445. information.
  1446.  
  1447. =head2 new()
  1448.  
  1449.     $x = Math::BigRat->new('1/3');
  1450.  
  1451. Create a new Math::BigRat object. Input can come in various forms:
  1452.  
  1453.     $x = Math::BigRat->new(123);                # scalars
  1454.     $x = Math::BigRat->new('inf');                # infinity
  1455.     $x = Math::BigRat->new('123.3');            # float
  1456.     $x = Math::BigRat->new('1/3');                # simple string
  1457.     $x = Math::BigRat->new('1 / 3');            # spaced
  1458.     $x = Math::BigRat->new('1 / 0.1');            # w/ floats
  1459.     $x = Math::BigRat->new(Math::BigInt->new(3));        # BigInt
  1460.     $x = Math::BigRat->new(Math::BigFloat->new('3.1'));    # BigFloat
  1461.     $x = Math::BigRat->new(Math::BigInt::Lite->new('2'));    # BigLite
  1462.  
  1463.     # You can also give D and N as different objects:
  1464.     $x = Math::BigRat->new(
  1465.         Math::BigInt->new(-123),
  1466.         Math::BigInt->new(7),
  1467.         );            # => -123/7
  1468.  
  1469. =head2 numerator()
  1470.  
  1471.     $n = $x->numerator();
  1472.  
  1473. Returns a copy of the numerator (the part above the line) as signed BigInt.
  1474.  
  1475. =head2 denominator()
  1476.     
  1477.     $d = $x->denominator();
  1478.  
  1479. Returns a copy of the denominator (the part under the line) as positive BigInt.
  1480.  
  1481. =head2 parts()
  1482.  
  1483.     ($n,$d) = $x->parts();
  1484.  
  1485. Return a list consisting of (signed) numerator and (unsigned) denominator as
  1486. BigInts.
  1487.  
  1488. =head2 as_int()
  1489.  
  1490.     $x = Math::BigRat->new('13/7');
  1491.     print $x->as_int(),"\n";        # '1'
  1492.  
  1493. Returns a copy of the object as BigInt, truncated to an integer.
  1494.  
  1495. C<as_number()> is an alias for C<as_int()>.
  1496.  
  1497. =head2 as_hex()
  1498.  
  1499.     $x = Math::BigRat->new('13');
  1500.     print $x->as_hex(),"\n";        # '0xd'
  1501.  
  1502. Returns the BigRat as hexadecimal string. Works only for integers. 
  1503.  
  1504. =head2 as_bin()
  1505.  
  1506.     $x = Math::BigRat->new('13');
  1507.     print $x->as_bin(),"\n";        # '0x1101'
  1508.  
  1509. Returns the BigRat as binary string. Works only for integers. 
  1510.  
  1511. =head2 bfac()
  1512.  
  1513.     $x->bfac();
  1514.  
  1515. Calculates the factorial of $x. For instance:
  1516.  
  1517.     print Math::BigRat->new('3/1')->bfac(),"\n";    # 1*2*3
  1518.     print Math::BigRat->new('5/1')->bfac(),"\n";    # 1*2*3*4*5
  1519.  
  1520. Works currently only for integers.
  1521.  
  1522. =head2 blog()
  1523.  
  1524. Is not yet implemented.
  1525.  
  1526. =head2 bround()/round()/bfround()
  1527.  
  1528. Are not yet implemented.
  1529.  
  1530. =head2 bmod()
  1531.  
  1532.     use Math::BigRat;
  1533.     my $x = Math::BigRat->new('7/4');
  1534.     my $y = Math::BigRat->new('4/3');
  1535.     print $x->bmod($y);
  1536.  
  1537. Set $x to the remainder of the division of $x by $y.
  1538.  
  1539. =head2 is_one()
  1540.  
  1541.     print "$x is 1\n" if $x->is_one();
  1542.  
  1543. Return true if $x is exactly one, otherwise false.
  1544.  
  1545. =head2 is_zero()
  1546.  
  1547.     print "$x is 0\n" if $x->is_zero();
  1548.  
  1549. Return true if $x is exactly zero, otherwise false.
  1550.  
  1551. =head2 is_pos()
  1552.  
  1553.     print "$x is >= 0\n" if $x->is_positive();
  1554.  
  1555. Return true if $x is positive (greater than or equal to zero), otherwise
  1556. false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
  1557.  
  1558. C<is_positive()> is an alias for C<is_pos()>.
  1559.  
  1560. =head2 is_neg()
  1561.  
  1562.     print "$x is < 0\n" if $x->is_negative();
  1563.  
  1564. Return true if $x is negative (smaller than zero), otherwise false. Please
  1565. note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
  1566.  
  1567. C<is_negative()> is an alias for C<is_neg()>.
  1568.  
  1569. =head2 is_int()
  1570.  
  1571.     print "$x is an integer\n" if $x->is_int();
  1572.  
  1573. Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise
  1574. false. Please note that '-inf', 'inf' and 'NaN' aren't integer.
  1575.  
  1576. =head2 is_odd()
  1577.  
  1578.     print "$x is odd\n" if $x->is_odd();
  1579.  
  1580. Return true if $x is odd, otherwise false.
  1581.  
  1582. =head2 is_even()
  1583.  
  1584.     print "$x is even\n" if $x->is_even();
  1585.  
  1586. Return true if $x is even, otherwise false.
  1587.  
  1588. =head2 bceil()
  1589.  
  1590.     $x->bceil();
  1591.  
  1592. Set $x to the next bigger integer value (e.g. truncate the number to integer
  1593. and then increment it by one).
  1594.  
  1595. =head2 bfloor()
  1596.     
  1597.     $x->bfloor();
  1598.  
  1599. Truncate $x to an integer value.
  1600.  
  1601. =head2 bsqrt()
  1602.     
  1603.     $x->bsqrt();
  1604.  
  1605. Calculate the square root of $x.
  1606.  
  1607. =head2 config
  1608.  
  1609.         use Data::Dumper;
  1610.  
  1611.         print Dumper ( Math::BigRat->config() );
  1612.         print Math::BigRat->config()->{lib},"\n";
  1613.  
  1614. Returns a hash containing the configuration, e.g. the version number, lib
  1615. loaded etc. The following hash keys are currently filled in with the
  1616. appropriate information.
  1617.  
  1618.         key             RO/RW   Description
  1619.                                 Example
  1620.         ============================================================
  1621.         lib             RO      Name of the Math library
  1622.                                 Math::BigInt::Calc
  1623.         lib_version     RO      Version of 'lib'
  1624.                                 0.30
  1625.         class           RO      The class of config you just called
  1626.                                 Math::BigRat
  1627.         version         RO      version number of the class you used
  1628.                                 0.10
  1629.         upgrade         RW      To which class numbers are upgraded
  1630.                                 undef
  1631.         downgrade       RW      To which class numbers are downgraded
  1632.                                 undef
  1633.         precision       RW      Global precision
  1634.                                 undef
  1635.         accuracy        RW      Global accuracy
  1636.                                 undef
  1637.         round_mode      RW      Global round mode
  1638.                                 even
  1639.         div_scale       RW      Fallback acccuracy for div
  1640.                                 40
  1641.         trap_nan        RW      Trap creation of NaN (undef = no)
  1642.                                 undef
  1643.         trap_inf        RW      Trap creation of +inf/-inf (undef = no)
  1644.                                 undef
  1645.  
  1646. By passing a reference to a hash you may set the configuration values. This
  1647. works only for values that a marked with a C<RW> above, anything else is
  1648. read-only.
  1649.  
  1650. =head1 BUGS
  1651.  
  1652. Some things are not yet implemented, or only implemented half-way:
  1653.  
  1654. =over 2
  1655.  
  1656. =item inf handling (partial)
  1657.  
  1658. =item NaN handling (partial)
  1659.  
  1660. =item rounding (not implemented except for bceil/bfloor)
  1661.  
  1662. =item $x ** $y where $y is not an integer
  1663.  
  1664. =item bmod(), blog(), bmodinv() and bmodpow() (partial)
  1665.  
  1666. =back
  1667.  
  1668. =head1 LICENSE
  1669.  
  1670. This program is free software; you may redistribute it and/or modify it under
  1671. the same terms as Perl itself.
  1672.  
  1673. =head1 SEE ALSO
  1674.  
  1675. L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
  1676. L<Math::BigInt::Pari> and  L<Math::BigInt::GMP>.
  1677.  
  1678. See L<http://search.cpan.org/search?dist=bignum> for a way to use
  1679. Math::BigRat.
  1680.  
  1681. The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
  1682. may contain more documentation and examples as well as testcases.
  1683.  
  1684. =head1 AUTHORS
  1685.  
  1686. (C) by Tels L<http://bloodgate.com/> 2001 - 2005.
  1687.  
  1688. =cut
  1689.